Nebula 1/Nebula One.iso/Internet/FTP/Mirror2.3/mirror

Text File | 1994-01-31 | 80.1 KB | 3,385 lines

#!/usr/bin/perl
# Make local directories mirror images of a remote sites
# By Lee McLoughlin <[e-mail]>
#  You can do what you like with this except claim that you wrote it or
#  give copies with changes not approved by Lee.  Neither Lee nor any other
#  organisation can be held liable for any problems caused by the use or
#  storage of this package.
#
# $Id: mirror.pl,v 2.3 1994/01/31 18:31:22 lmjm Exp lmjm $
# $Log: mirror.pl,v $
# Revision 2.3  1994/01/31  18:31:22  lmjm
# Allow for funny chars in filenames when calling the shell (Erez).
# Added compress_size_floor to avoid compressing small files (David).
# Added get_missing to just delete files not on remote system (Pieter).
# Don't try to delete old dirs if no time set (Pieter).
# Zap .dir$$ files, and keep then in $big_temp.
# Pretty print time in comparisons.
# Move the large comparision conditionals into routines (David).
# Allow for sites with limited filename lengths.
# Allow for deleted files when doing deletes.
# Don't delete dirs that are really symlinks.
#
# Revision 2.2  1993/12/14  11:09:15  lmjm
# Allow for no flock.
# Use installed socket.ph.
# Allow for system 5.
# Use percentage defaults on max_delete_*
# Checkout regexps before using.
# Allow for extra leading | in local_ignore.
# Return better exit codes.
# Fixups for recurse_hard.
# Smarter symlink handling.
#
# Revision 2.1  1993/06/28  14:59:00  lmjm
# Full 2.1 release
#
#

# Default settings file loaded from a directory in PERLLIB
$defaults_file = 'mirror.defaults';
$load_defaults = 1;

# Try to find the default localation of various programs via
# the users PATH then using $extra_path
$extra_path = '/usr/local/bin:/usr/new/bin:/usr/public/bin:/usr/ucb:/usr/bin:/bin:/etc:/usr/etc:/usr/local/etc:';
$ENV{ 'PATH' } .= ':' . $extra_path;

# If compressing a local file to send need somewhere to store the temp
# compressed version.
$big_temp = '/var/tmp';

# Hopefully we have flock.
$can_flock = 1;

# NOTE:
#  It is not an error for a program not to be found in the path as the user
# may be setting it as part of the package details or defaults.

# Used by the save_deletes option
$mv_prog = 'mv -f';

# compress must be able to take the -d arg to cause it to uncompress.
$sys_compress_prog = &find_prog( 'compress' ) ||
    die "No compress command in path\n";
$sys_compress_suffix = 'Z';
# Like compress gzip must be able to take -d
if( $gzip_prog = &find_prog( 'gzip' ) ){
    # Force maximum compression with gzip
    $gzip_level = ' -9';
    $gzip_prog .= $gzip_level;
    $gzip_suffix = 'gz';
    $old_gzip_suffix = 'z';
}

# A mail program that can be called as: "$mail_prog person_list'
# Can be overridden with the mail_prog keyword.
# If you use $mail_subject to pass extra arguments then remember that
# the mail program will need to know how to handle them.
$mail_prog = &find_prog( 'mailx' );
if( ! $mail_prog ){
    $mail_prog = &find_prog( 'Mail' );
}
if( ! $mail_prog ){
    $mail_prog = &find_prog( 'mail' );
}
$current_mail_to = '';        # Keep track of who mail is being sent to.

# Used to remove directory heirarchies.  This program is passed the -rf
# arguments.
$rm_prog = &find_prog( 'rm' );

# Generate checksums
$sum_prog = &find_prog( 'sum' );

# SPECIAL NOTE: This is eval'd, so DONT put double-quotes (") in it.
# You can get local variables to appear as in the second example:
$mail_subject = '-s \'mirror update\'';
# $mail_subject = ' -s \'mirror update of $package\'';

# When scanning the local directory, how often to prod the remote
# system to keep the connection alive
$prod_interval = 60;

# Put the directory that mirror is actually in at the start of PERLLIB.
$dir = &real_dir_from_path( $0 );
unshift( @INC, $dir );

# Make sure that your PERLLIB environment variable can get you
# all these or that they are installed.
require 'sys/socket.ph';
require 'ftp.pl';
require 'lsparse.pl';
require 'dateconv.pl';

# Find some local details
chop( $home = `pwd` );
chop( $host = `(hostname || uname -n || uuname -l) 2>/dev/null` );
if( $hn = (gethostbyname( "$hostname" ))[ 0 ] ){
    $hostname = $hn;
}

# Some systems hold the username in $USER, some in $LOGNAME.
$me = $ENV{'USER'} || $ENV{'LOGNAME'};

# Files matching this pattern are usually compressed.
$squished = '\.(Z|z|gz)$';

# special /bin/sh chars that must be escaped.
$shell_metachars = '\"|\$|`|\\\\';

# Remote directory parsing fail if not given input every readtime seconds.
$parse_time = 600;

# Timeout are not fatal unless you get more than this number of them.
$max_timeouts = 20;

# If connected to a site then this holds the site name.
$connected = '';

# Umask setting.
$curr_umask = sprintf( "0%o", umask );

# mapping from a pathname to a number - just to make the keys to assoc arrays
# shorter.
$map_init = 1;    # just so I know 0 is invalid

$tmp = "/tmp";
@assocs = ( 'local_map', 'remote_map' );

# Create a reasonable set of defaults
$default{ 'package' } = '';    # should be a unique handle for the "lump" to be mirrored
$default{ 'comment' } = '';    # General comment used in report
$default{ 'skip' } = '';    # If set then skip this entry giving value as reason
$default{ 'site' } = '';    # site to connect to
$default{ 'remote_dir' } = '';    # remote directory to mirror
$default{ 'local_dir' } = '';    # local directory to copy into
$default{ 'remote_user' } = 'anonymous';  # the remote guest account name
$default{ 'remote_password' } = "$me@$hostname";
$default{ 'get_patt' } = ".";    # regex of pathnames to retrieve
$default{ 'exclude_patt' } = ''; # regex of pathnames to ignore
$default{ 'update_local' } = 0;    # Don't just update local dirs
$default{ 'local_ignore' } = ''; # regex of local pathnames to totally ignore
$default{ 'do_deletes' } = 0;    # delete dest files if not in src tree
$default{ 'delete_excl' } = ''; # regex of local pathnames to ignore when deleting
$default{ 'delete_patt' } = '.';# delete only files which match this pattern
$default{ 'delete_get_patt' } = 0;# true: set delete_patt to get_patt
$default{ 'save_deletes' } = 0;    # save local files if not in remote
$default{ 'save_dir' } = 'Old';    # directory in which to create tree for keeping
                # files no longer in remote
$default{ 'max_delete_files' } = '10%'; # Any more than this and DONT delete
$default{ 'max_delete_dirs' } = '10%'; # Any more than this and DONT delete
$default{ 'max_days' } = 0;    # Ignore age of file
$default{ 'split_max' } = 0;    # Files > this size can be split up.
$default{ 'split_patt' } = '';  # Files must match this pattern to be split
$default{ 'split_chunk' } = 100 * 1024; # Size of split-up chunks
$default{ 'ls_lR_file' } = '';    # remote file containing ls-lR - else use remote ls
$default{ 'local_ls_lR_file' } = ''; # local file containing ls-lR
                # useful when first copying a large remote package
$default{ 'recursive' } = 1;    # true indicates to do recursive processing
$default{ 'recurse_hard' } = 0;    # true indicates have to cwd+ls for each remote
                # subdirectory - AVOID wherever possible.
$default{ 'flags_recursive' } = '-lRat'; # Flags passed to remote dir
$default{ 'flags_nonrecursive' } = '-lat'; # Flags passed to remote dir
$default{ 'name_mappings' } = '';# remote to local pathname mappings
                 # (eg s:old:new)
$default{ 'external_mapping' } = '';# remote to local mapping by external routine
$default{ 'get_newer' } = 1;    # get remote file if its date is newer than local
$default{ 'get_size_change' } = 1; # get the file if size if different than local
$default{ 'compress_patt' } = ''; # compress files matching this pattern
$default{ 'compress_excl' } = $squished; # dont compress regexp (case insensitive)
$default{ 'compress_prog' } = $sys_compress_prog; # Program to compress files.
$default{ 'compress_suffix' } = $sys_compress_suffix; # Suffix on compressed files
$default{ 'compress_conv_patt' } = '(\.Z|\.taz)$';
    # compress->gzip files matching this pattern
$default{ 'compress_conv_expr' } = 's/\.Z$/.gz/;s/\.taz$/.tgz/';
    # perl expressions to convert names of files from compress->gzip
$default{ 'compress_size_floor' } = 0;  # don't compress files < this size
$default{ 'force_times' } = 1;    # Force local file times to match the original
$default{ 'retry_call' } = 1;    # Retry the call if it fails first time
$default{ 'update_log' } = '';    # Filename where an update report is to be kept
$default{ 'mail_to' } = '';    # Mail a report to these addresses
$default{ 'user' } = '';    # UID/user name to give to local pathnames
$default{ 'group' } = '';    # GID/group name to give to local pathnames
$default{ 'file_mode' } = 0444;    # Mode to give files created locally
$default{ 'dir_mode' } = 0755;    # mode to give directories created locally
$default{ 'timeout' } = 120;    # timeout ftp requests after this many seconds
$default{ 'ftp_port' } = 21;    # port number of remote ftp daemon
$default{ 'proxy' } = 0;    # normally use regular ftp
$default{ 'proxy_ftp_port' } = 4514; # default from Sun
$default{ 'proxy_gateway' } = $ENV{ 'INTERNET_HOST' };    # used if($proxy)
$default{ 'mode_copy' } = 0;    # true indicates to copy the mode bits
$default{ 'interactive' } = 0;    # noninteractive copy default
$default{ 'text_mode' } = 0;    # transfer in binary mode by default
$default{ 'force' } = 0;    # don't force by default
$default{ 'get_file' } = 1;    # perform get, not put by default
$default{ 'verbose' } = 0;    # Verbose messages
$default{ 'remote_fs' } = 'unix'; # Remote filestore
    # Other posibilies dls, netware and vms
$default{ 'vms_keep_versions' } = 1; # Keep multiple VMS versions
$default{ 'vms_xfer_text' } = 'readme$|info$|listing$|\.c$';
                # pattern of VMS files to xfer in TEXT mode
                # (Case insensitive)
$default{ 'delete_source' } = 0;# delete source after xfer (default = NO!!!)
$default{ 'disconnect' } = 0;    # Force close at end of package EVEN if
                # next package is to the same site
$default{ 'mail_prog' } = $mail_prog; # the mail program (see $mail_prog)
$default{ 'mail_subject' } = $mail_subject; # Subject passed to mail_prog
$default{ 'hostname' } = $hostname; # The LOCAL hostname
$default{ 'umask' } = 07000; # DONT allow setuid things by default
# If mirroring a VERY large directory then it is best to put the assoc
# arrays in files (use command line switch -F. to turn on).
$default{ 'use_files' }  = 0;
# Use local time NOT gmt to timestamp files.
# The original mirror got it wrong you should be using localtime
# This variable is only here to allowed packages to be switched over one by
# one.  (See also the -T flag.)
$default{ 'use_timelocal' }  = 1;
# Used for group and gpass.  (As in ftp.1 site group/gpass commands.)
$default{ 'remote_group' } = '';
$default{ 'remote_gpass' } = '';
# Set the remote idle timer to this
$default{ 'remote_idle' } = '';
# prevent symlinks to non-existant files
$default{ 'make_bad_symlinks' } = 0;
# Follow symlinks to pathnames matching this regexp.
$default{ 'follow_local_symlinks' } = '';
# Set get_missing to 0 to just delete files not on remote system
$default{ 'get_missing' } = 1;

@boolean_values = ( 'get_newer', 'get_size_change', 'do_deletes',
    'update_local',    'force_times', 'retry_call', 'recursive',
    'mode_copy', 'disconnect', 'interactive', 'text_mode',
    'force', 'get_file', 'verbose', 'proxy', 'delete_get_patt',
    'delete_source', 'save_deletes', 'use_files', 'use_timelocal',
    'make_bad_symlinks', 'recurse_hard', 'get_missing' );
%boolean_values = ();
&set_assoc_from_array( *boolean_values );

@regexp_values = ( 'get_patt', 'exclude_patt', 'local_ignore',
          'delete_patt', 'delete_excl', 'split_patt', 'save_deletes',
          'compress_patt', 'compress_excl', 'compress_conv_patt' );

#
# message levels used by &msg( level, msg )
# if you call msg as &msg( msg ) the level is presumed to be just $pr.
$pr = 0;    # Always print out messages
$log = 1;    # push this messages onto @log

#
# Exit status
$exit_status = 0;
$exit_status_xfers = 0;

# "#defines" for the above
$exit_xfers = 16;  # Add this to the exit code to show xfers took place
$exit_ok = 0;
$exit_fail = 1;
$exit_fail_noconnect = 2;

# -d        Turn on debugging - more -d's means more debugging.
# -ppattern    Just do packages matching pattern.
# -Rpattern    Skip till the first package name matches pattern then do all.
#        it and following packages.
# -n        Do nothing, just show what would be done.
# -F        Use files for assoc arrays (see also the variable use_files).
# -gsite:path
#        Get all files on given site.  If path matches .*/.+ then
#        it is the name of the directory and the last part is the
#        pattern of filenames to get.  If path matches .*/ then
#        it is the name of a directory and all its contents are retrieved.
#        Otherwise path is the pattern to be used in '/'.
# -r        Same as "-krecursive=false".
# -kvar=val    set variable to value.
# -uusername    Same as "-kremote_user=username", prompts for remote_password.
# -v        Print version and exit.
# -T        Dont transfer just force local timestamps to match remote.
# -N        Don't load mirror.defaults.
# -L        Generate a pretty list of what is being mirrored.
# -m         Same as "-kmode_copy=true".

# -Cconfig_file
# -P         Same as "-kget_file=false -kinteractive=true".
# -G        Same as "-kget_file=true -kinteractive=true".
# -t         Same as "-ktext_mode=true".
# -f        Same as "-kforce=true".
# -sSITENAME    Same as "-ksite=SITENAME.
# -ULOGFILE    Set the upload log to LOGILE - if none given uses
#        the file $home/upload_log.$mday.$mon.$year

# -DUMP        Dump perl - to be later undumped --  THIS DOES NOT YET WORK!!!

sub msg_version
{
    &msg( '$Id: mirror.pl,v 2.3 1994/01/31 18:31:22 lmjm Exp lmjm $' . "\n" );
}

parse_args:
while( $ARGV[ 0 ] =~ /^-/ ){
    local( $arg ) = shift;

    if( $arg eq '-d' ){
        if( $debug == 2 ){
            &msg_version();
        }
        $| = 1;
        $debug++;
        next;
    }

    if( $arg =~ /^-(p)(.*)/ || $arg =~ /^-(R)(.*)/ ){
        local( $flag, $p ) = ($1, $2);
        if( $flag eq 'R' ){
            # Skip all packages till a match is made
            # then process ALL further packages
            $skip_till = 1;
        }
        if( ! $p ){
            # Must be -p/-R space arg
            $p = shift;
        }
        if( $p !~ /[a-zA-Z0-9]/ ){
            die "Invalid package name to -p of: $p\n";
            next;
        }
        # Only mirror the named packages
        $do_packages{ $p } = 1;
        $limit_packages = 1;
        next;
    }

    if( $arg eq '-n' ){
        # Do nothing - just show what would be done
        $dont_do = 1;
        $debug += 2;
        $| = 1;
        next;
    }

    if( $arg eq '-F' ){
        # Use files for the dir listings assoc lookups
        $use_files = 1;
        $command_line{ 'use_files' } = 1;
        next;
    }

    if( $arg eq '-T' ){
        # Don't actually get any files but just force
        # local timestamps to be the same on the remote system
        $timestamp = 1;
        $command_line{ 'force_times' } = 'true';
        next;
    }

    if( $arg =~ /^-g(.*)$/ ){
        # the next arg is the site:path to get
        local( $site_path ) = $1;

        if( ! $site_path ){
            # Must be -g space arg
            $site_path = shift;
        }

        # DONT use the system defaults!
        $load_defaults = 0;

        # This is probably interactive so print interactively
        $| = 1;

        if( $site_path =~ /(.*):(.*)?/ ){
            local( $site, $path ) = ($1, $2);
            push( @get_sites, $site );
            # Find the directory and files
            if( $path =~ m|^(.*)/([^/]*)$| ){
                if( $1 eq '' ){
                    push( @get_paths, '/' );
                }
                else {
                    push( @get_paths, $1 );
                }
                if( $2 eq '' ){
                    push( @get_paths, $1 );
                    push( @get_patt, '.' );
                }
                else {
                    push( @get_patt, "^$2$" );
                }
            }
            else {
                push( @get_paths, '.' );
                push( @get_patt, "^$path$" );
            }
        }
        else {
            die "expected -gsite:path got $arg";
        }
        next;
    }

    if( $arg eq "-r" ){
        # no recursive copy
        $command_line{ 'recursive' } = 0;
        next;
    }

    if( $arg =~ /^-k(.*)=(.*)/ ){
         # set the keyword = value
        if( !defined( $default{ "$1" } ) ){
            warn "Invalid keyword $1\n";
        } else {
            $command_line{ "$1" } = $2;
        }
        next;
    }

    if( $arg =~ /^-u(.*)/ ){
        local( $user ) = $1;

        if( ! $user ){
            # must be -u space user
            $user = shift;
        }

        # override the user name
            $command_line{ 'remote_user' } = $user;
        # and ask for a password
        $command_line{ 'remote_password' } = &get_passwd( $user );
        next;
    }

    if( $arg eq '-N' ){
        $load_defaults = 0;
        next;
    }

    if( $arg eq '-v' ){
        &msg_version();
        exit( 0 );
    }

        if( $arg eq '-L' ){
                # Generate a pretty list of what is being mirrored
                $pretty_print = 1;
                next;
        }

        if( $arg eq '-m' ){
                # propagate the mode
        $command_line{ 'mode_copy' } = 'true';
        next;
        }

    # Old command line interface flags
    if( $arg =~ /^-C(.*)/ ){
        # specify the config file
        local( $c ) = $1;
        if( $c !~ /./ ){
            die "Must give config file name -Cname ($arg)\n";
        }
        # Only mirror the named packages
            push( @config_files, $c);
        next;
    }

        if( $arg eq '-P' ){
                # put files
        $command_line{ 'get_file' } = 'false';
        $command_line{ 'interactive' } = 'true';
        next;
        }

        if( $arg eq '-G' ){
                # get files
        $command_line{ 'get_file' } = 'true';
        $command_line{ 'interactive' } = 'true';
        next;
        }

        if( $arg eq '-t' ){
                # set the file mode to text
        $command_line{ 'text_mode' } = 'true';
        next;
        }

        if( $arg eq '-f' ){
                # force file transfers irregardless of date/size matches
        $command_line{ 'force' } = 'true';
        next;
        }

    if( $arg =~ /^-s(.*)/ ){
        # override the site name
        $command_line{ 'site' } = $1;
        next;
    }

    if( $arg =~ /^-U(.*)/ ){
        $upload_log = $1;
        if( $upload_log eq '' ){
            local( $sec,$min,$hour,$mday,$mon,$year,
                $wday,$yday,$isdst )
                = localtime( time );
            $mon++;
            $upload_log = "$home/upload_log.$mday.$mon.$year";
        }

        next;
    }

    if( $arg eq '-DUMP' ){
        # THIS DOES NOT YET WORK!!!!!
        $dumped_version = 1;
        warn "Dumping perl\n";
        dump parse_args;
    }

    warn "Unknown arg $arg, skipping\n";
}

# Handle multi-line buffers in a sane way
$* = 1;

$interactive = $command_line{ 'interactive' };

if( ! $interactive ){
    local( $c );

    # The remainder of ARGV are package names
    foreach $c ( @ARGV ){
        push( @config_files, $c );
    }
}

if( $interactive && $limit_packages){
    die "Can not mix -p and interactive";
}

$value{ 'remote_user' } = $default{ 'remote_user' };
%value = ();
&set_defaults();

if( $load_defaults ){
    local( $dir, $mp );
    foreach $dir ( @INC ){
        local( $f ) = "$dir/$defaults_file";
        if( -f $f ){
            $mp = $f;
            last;
        }
    }
    if( $mp ){
        &msg( "defaults from $mp\n" ) if $debug > 2;
        splice( @config_files, 0, 0, $mp );
    }
    else {
        warn "No $defaults_file found in perl library path\n";
    }
}
elsif( $debug > 1 ){
    &msg( "not loading $defaults_file\n" );
}


&interpret_config_files();

# Shut down any remaining ftp session
&disconnect();

&msg( "All done, Exiting\n" ) if $debug;
exit( $exit_status + $exit_status_xfers );


$key = ''; # The current keyword
$value = ''; # the value for the keyword

sub interpret_config_files
{
    local( $fname );

    if( $#get_sites >= 0 ){
        while( $#get_sites >= 0 ){
            $value{ 'site' } = pop( @get_sites );
            $value{ 'remote_dir' } = pop( @get_paths );
            $value{ 'get_patt' } = pop( @get_patt );
            $value{ 'local_dir' } = '.';
            $value{ 'remote_user' } = 'anonymous';
            $exit_status = &do_mirror();
        }
        return;
    }


    if( $command_line{ 'interactive' } ){
        # No config file to read
        $value{ 'package' } = 'interactive';
        $exit_status = &do_mirror();
        return;
    }

    # if no configuration files were specified use standard input
    @ARGV = @config_files;
    &interpret_config();
}

sub interpret_config
{
    while( <> ){
        # Ignore comment and blank lines
        next if /^\s*#/ || /^\s*$/;

        &parse_line();

        # Is this a new package?
        if( $value{ 'package' } && $key eq 'package' ){
            # mirror the existing package
            $exit_status = &do_mirror();

            # reset
            &set_defaults();

            # Make sure I'm at the right place for <> to work!
            chdir $home;
        }

        if( $debug > 3 ){
            &msg( "$key \"$value\"\n" );
        }

        $value{ $key } = $value;

        # do an explicit close for each file so $. gets reset
        if( eof( ARGV ) ){
            if( $debug > 3 ){
                &msg( "-- end of config file \"$ARGV\"\n" );
            }
            close( ARGV );
        }
    }

    # Mirror the last package in the file
    if( $value{ 'package' } ){
        $exit_status = &do_mirror();
    }
}

# parse each line for keyword=value
sub parse_line
{
    local( $eqpl );
    local( $cont ) = '&';

    chop;
    if( /^\s*([^\s=+]+)\s*([=+])(.*)?$/ ){
        ($key, $eqpl, $value) = ($1, $2, $3);
        # If the value ends in the continuation character then
        # tag the next line on the end (ignoring any leading ws).
        while( $value =~ /^(.*)$cont$/o && !eof ){
            $_ = <>;
            local( $v ) = $1;
            if( /^\s*(.*)$/ ){
                $value = $v . $1;
            }
        }
        if( $debug > 3 ){
            &msg( "read: $key$eqpl$value\n" );
        }
    }
    else {
        warn "unknown input in \"$ARGV\" line $. of: $_\n";
    }
    if( ! defined( $default{ "$key" } ) ){
        die "unknown keyword in \"$ARGV\" line $. of: $key\n";
    }
    if( $eqpl eq '+' ){
        $value = $value{ $key } . $value;
    }
}

# Initialise the key values to the default settings
sub set_defaults
{
    %value = %default;
}

# Override the current settings with command line values
sub command_line_override
{
    local( $key, $val, $overrides );

    while( ($key, $val) = each %command_line ){
        $overrides++;
        if( $boolean_values{ $key } ){
            # a boolean value
            $value{ $key } = &istrue( $val );
        } else {
            # not a boolean value
            $value{ $key } = $val;
        }
    }

    if( $debug > 4 ){
        if( $overrides ){
            &pr_variables( "keywords after command line override\n" );
        }
        else {
            &msg( "No command line overrides\n" );
        }
    }
}

# set each variable $key = $value{ $key }
sub set_variables
{
    local( $key, $val );

    while( ($key, $val) = each %value ){
        # for things like passwords it is nice to have the
        # real value in a file
        if( $val =~ /^\<(.*)$/ ){
            local( $val_name ) = $1;
            open( VAL_FILE, $val_name ) ||
                die "can't open value file $val_name\n";
            $val = <VAL_FILE>;
            close( VAL_FILE );
            chop $val if $val =~ /\n$/;
        }

        if( $boolean_values{ $key } ){
            # a boolean value
            eval "\$$key = &istrue( $val )";
        }
        else {
            # not a boolan value
            # Change all \ to \\ since \'s will be escaped in
            # the following string used in the eval.
            $val =~ s/([^\\])(')/$1\\$2/g;
            eval "\$$key = '$val'";
        }
        if( $key eq 'compress_prog' ){
            if( $val eq 'compress' ){
                $compress_prog = $sys_compress_prog;
                $compress_suffix = $sys_compress_suffix;
            }
            elsif( $val eq 'gzip' ){
                if( ! $gzip_prog ){
                    die "Trying to use gzip but not found in PATH\n";
                }
                $compress_prog = $gzip_prog;
                $compress_suffix = $gzip_suffix;
            }
            elsif( $debug > 2 && $compress_prog ne $gzip_prog &&
                   $compress_prog ne $sys_compress_prog ){
                &msg( "compress_prog not compress or gzip, presuming program name\n" .
                      "- user must set compress_suffix\n" );
            }
            &upd_val( 'compress_prog' );
            &upd_val( 'compress_suffix' );
        }
    }

    # Reset the umask if needed.
    # Do it here to try and get it done as early as possible.
    # If the user doesn't use octal umasks this will cause umask
    # to be called again unnecessarily - but that is pretty cheap.
    if( $umask && $umask != $curr_umask ){
        local( $val ) = $umask;
        $val = oct( $val ) if $val =~ /^0/;
        umask( $val );
        $curr_umask = sprintf( "0%o", umask );
    }
}

sub upd_val
{
    local( $key ) = @_;
    if( $package eq 'defaults' ){
        $default{ $key } = $value{ $key };
    }
}

sub pr_variables
{
    local( $msg ) = @_;
    local( $nle ) = 60;
    local( $out ) = 0;
    local( $key, $val, $str );

    &msg( $msg );
    &msg( "package=$package  $site:$remote_dir -> $local_dir\n\t" );

    for $key ( sort keys( %value ) ){
        next if $key eq 'package' ||
            $key eq 'site' ||
            $key eq 'remote_dir' ||
            # Don't show passwords when interactive
            ($interactive && $key eq 'remote_password') ||
            ($interactive && $key eq 'remote_gpass');
        # Report the value in the actual variable
        $val = eval "\$$key";
        $str = "$key=\"$val\" ";
        &msg( $str );
        $out += length( $str );
        # Output newlines when a line is full
        if( $out > $nle ){
            $out = 0;
            &msg( "\n\t" );
        }
    }
    &msg( "\n" );
}

# Mirror the package, return exit_status
sub do_mirror
{
    $package = $value{ 'package' };

    if( $package eq 'defaults' ){
        # This isn't a real site - just a way to change the defaults
        %default = %value;

        return $exit_ok;
    }

    # Only do this package if given by a -Ppack argument
    if( $limit_packages && ! $do_packages{ $package } ){
        return;
    }

    if( $skip_till ){
        # Found a package so process all packages from now on
        $skip_till = $limit_packages = 0;
    }

    local( $exit_status ) = $exit_fail_noconnect;  # Presume the worse.
    $timeouts = 0;

    # set things from the command line arguments
    &command_line_override();

    if( ! &checkout_regexps() ){
        &msg( "skipping package\n\n" );
        return $exit_status;
    }

    # set each variable $key = $value{ $key }
    &set_variables();

    # don't trash locally glossed over things with stuff from the remote
    if( $local_ignore ){
        if( $exclude_patt ){
            $exclude_patt .= '|' . $local_ignore;
        }
        else {
            $exclude_patt = $local_ignore;
        }
    }

    if( $debug > 3 ){
        &pr_variables( "\n" );
    }
    elsif( $package && ! $pretty_print ){
        &msg( "package=$package $site:$remote_dir -> $local_dir\n");
    }

    # Don't bother if trying to mirror here!
    if( !$interactive && !$force && ((gethostbyname( $site ))[0] eq $hostname) ){
        &msg( "Skipping $site as it is this local site!\n\n" );
        return $exit_ok;
    }

    chdir $home;

    $max_age = 0;
    if( $value{ 'max_days' } ne '0' ){
        $max_age = time - ($value{ 'max_days' } * 24 * 60 * 60);
        &msg( "max_age = $max_age\n" ) if $debug > 1;
    }

    # pull in external code, if required
    if( $external_mapping ){
        &msg( "Loading external mapping from $external_mapping.\n" ) if $debug > 0 ;
        do $external_mapping || die "Cannot load from $external_mapping";
    }

    if( $debug ){
        # Keep the ftp debugging lower than the rest.
        &ftp'debug( $debug - 1);
    }
    else {
        &ftp'debug( $verbose );
    }

    if( $recurse_hard ){
        $recursive = 1;
    }

    if( ! $interactive ){
        $ftp'showfd = 'STDOUT';
    }
    &ftp'set_timeout( $timeout );
    &ftp'set_signals( "main'msg" );

    # Useful string in prints
    $XFER = $get_file ? "get" : "put";

    # create the list of items to copy
    @transfer_list = ();
    if( $interactive ){
        # copy the remainder of items from argv to the transfer list
        while( @ARGV ){
            # copy the local directory
            if( @ARGV ){
                push( @transfer_list, shift( @ARGV ) );
            }

            # copy the remote directory
            if( @ARGV ){
                push( @transfer_list, shift( @ARGV ) );
            }
            else {
                die "remote directory must be specified\n";
            }

            # copy the pattern, if available
            if( @ARGV ){
                push( @transfer_list, shift( @ARGV ) );
            } else {
                push( @transfer_list, $default{ 'get_patt' } );
            }
        }

        if( $debug > 1 ){
            local( @t );
            @t  = @transfer_list;

            while( @t ){
                printf( "local_dir=%s remote_dir=%s patt=%s\n",
                    shift( @t ), shift( @t ), shift( @t ) );
            }
        }
    }
    else {
        push( @transfer_list, $local_dir );
        push( @transfer_list, $remote_dir );
        push( @transfer_list, $get_patt );
        }


    if( $update_local && $get_patt ){
        if( $get_patt ne $default{ 'get_patt' } ){
            &msg( "Cannot mix get_patt and update_local.  get_patt ignored\n" );
        }
        $get_patt = '';
    }


    if( !$site || (!$interactive && (!$local_dir || !$remote_dir)) ){
        &msg( "Insufficient details for package to be fetched\n" );
        &msg( "Must give at least: site, remote_user, remote_dir and local_dir\n\n" );
        return $exit_status;
    }

        if( $pretty_print ){
                # Don't actually mirror just print a pretty list
                # of what would be mirrored.  This is for mailing to
                # people
        if( $skip ){
            return $exit_ok;
        }
                &msg( "$package  \"$comment\"\n" );
                &msg( "  $site:$remote_dir  -->  $local_dir\n\n" );
                return $exit_ok;
        }

    if( $skip ){
        &msg( "Skipping $site:$package because $skip\n\n" );
        return $exit_ok;
    }

    $split_max = &to_bytes( $split_max );
    $split_chunk = &to_bytes( $split_chunk );

    if( $split_max && $split_max <= $split_chunk ){
        &msg( "split_max <= split_chunk - skipping package\n" );
        &msg( " $split_max <= $split_chunk\n\n" );
        return $exit_status;
    }

    if( $split_chunk && ($split_chunk & 511) ){
        &msg( "split_chunk bad size - skipping package\n" );
        &msg( " $split_chunk should be a multiple of 512 bytes\n\n" );
        return $exit_status;
    }

    local( $con ) = &connect();
    if( $con <= 0 ){
        &msg( "Cannot connect, skipping package\n" );
        &disconnect();
        &msg( "\n" );
        return $exit_status;
    }

    if( $con == 1 ){
        &msg( "login as $remote_user\n" ) if $debug > 1;
        $curr_remote_user = $remote_user;
        if( ! &ftp'login( $remote_user, $remote_password ) ){
            &msg( "Cannot login, skipping package\n" );
            &disconnect();
            &msg( "\n" );
            return $exit_status;
        }
        $can_restart = (&ftp'restart(0) == 1);
        if( $debug > 1 ){
            &msg( "Can " . $can_restart ? '' : "not " . "do restarts\n" );

        }

        if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
            &msg( "Cannot set type\n" );
        }
    }
    else {
        # Already connected to this site - so no need to login again
        &msg( "Already connected to site $site\n" ) if $debug;
    }

    $exit_status = $exit_fail; # ok this is now the worse case

    # Mirror thinks in terms of Unix pathnames.
    # Ask ftp.pl to map any remote name it is about to use by
    # setting the namemap functions.
    if( $remote_fs =~ /vms/i ){
        $vms = 1;
        &ftp'set_namemap( "main'unix2vms", "main'vms2unix" );
    }
    else {
        $vms = 0;
        # No mapping necessary
        &ftp'set_namemap( '' );
    }

    if( ! $get_file || $idle ){
        local( @rhelp ) = &ftp'site_commands();
        $remote_has_chmod = grep( $_ eq 'CHMOD', @rhelp);
        $remote_has_idle = grep( $_ eq 'IDLE', @rhelp);
        if( $debug > 2 ){
            &msg( "remote site " . ($remote_has_chmod ? "has" : "hasn't") . " got chmod\n" );
            &msg( "remote site " . ($remote_has_idle ? "has" : "hasn't") . " got idle\n" );
        }
    }

    if( $remote_has_idle && $remote_idle ){
        if( ! &ftp'quote( "site idle $remote_idle" ) ){
            &msg( "Cannot set remote idle\n" );
        }
        elsif( $debug > 2 ){
             &msg( "remote idle has been set to $remote_idle\n" );
        }
    }

    if( $remote_group ){
        if( ! &ftp'quote( "site group $remote_group" ) ){
            &msg( "Cannot set remote group\n" );
        }
        elsif( $debug > 2 ){
             &msg( "remote group has been set to $remote_group\n" );
        }
    }

    if( $remote_gpass ){
        if( ! &ftp'quote( "site gpass $remote_gpass" ) ){
            &msg( "Cannot set remote gpass\n" );
        }
        elsif( $debug > 2 ){
             &msg( "remote gpass has been set\n" );
        }
    }

    @log = ();

    while( @transfer_list ){
        # get files
        $local_dir = shift( @transfer_list );
        $remote_dir = shift( @transfer_list );
        $get_patt = shift( @transfer_list );

        # Clear all details
        undef( @xfer_dest, @xfer_src, @xfer_attribs, @things_to_make );

        if( $use_files ){
            &create_assocs();
        }

        if( !&get_local_directory_details() ){
            &msg( "Cannot get local directory details ($local_dir)\n" );
            &disconnect();
            &msg( "\n" );
            return $exit_status;
        }

        # Create a get_patt from the contents of the local directory
        if( $update_local && $#get_top >= 0 ){
            $get_patt = '^' . join( '|^', @get_top );
            $get_patt =~ s/$squished//g;
            &msg( "get_patt = $get_patt\n" ) if $debug;
        }

        if( !&get_remote_directory_details() ){
            &msg( "Cannot get remote directory details ($remote_dir)\n" );
            &disconnect();
            &msg( "\n" );
            return $exit_status;
        }

        if( $get_file ){
            &compare_dirs(
                *remote_sorted,
                 *remote_map, *remote_time,
                  *remote_size, *remote_type,
                *local_sorted,
                 *local_map, *local_time,
                  *local_size, *local_type,
                   *local_keep, *local_keep_totals );
        } else {
            &compare_dirs(
                *local_sorted,
                 *local_map, *local_time,
                  *local_size, *local_type,
                *remote_sorted,
                 *remote_map, *remote_time,
                  *remote_size, *remote_type,
                   *remote_keep, *remote_keep_totals );
        }

        if( $timestamp ){
            &set_timestamps();
            next;
        }

        &make_dirs();
        &do_all_transfers();

        $exit_status = $exit_ok;    # Everything went ok.

        if( $get_file ){
            # I must have finished with the remote information
            # so clear it out.
            &clear_remote();
        }
        else {
            # clear out local info.
            &clear_local();
        }

        if( $save_deletes ){
            # If $save_dir is null, make $save_dir to be
            # subdirectory 'Old' under
            # current path
            if( ( ! defined( $save_dir ) ) || ( $save_dir eq '' ) ){
                $save_dir = "$cwd/Old";
            }

            # If $save_dir is not absolute, take it as
            # subdirectory of current path
            if( $save_dir !~ m,^/, ){
                           $save_dir = "$cwd/$save_dir";
                   }
        }

        if( $do_deletes || $save_deletes ){
            if( $get_file ){
                &do_deletes(
                    *local_sorted,
                     *local_map,
                      *local_type, *local_keep,
                       *local_totals, *local_keep_totals );
            }
            else {
                &do_deletes(
                    *remote_sorted,
                     *remote_map,
                      *remote_type, *remote_keep,
                       *remote_totals, *remote_keep_totals );
            }
        }

        &make_symlinks();
        undef( @things_to_make );

        # No more transfers if the connection has died.
        last if ! $connected;
    }

    &clear_local();
    &clear_remote();

    if( $use_files ){
        # Close and zap.
        &delete_assocs();
    }

    # Should I force a disconnect now?
    if( $connected && $disconnect ){
        &disconnect();
    }

    if( $dont_do || $timestamp ){
        # Don't generate logs/email
        &msg( "\n" );
        return $exit_status;
    }

    local( $now );
    chop( $now = `date` );
    if( $update_log ){
        if( ! open( logg, ">>$update_log" ) ){
            &msg( "Cannot append to $update_log\n\n" );
            return $exit_fail;
        }
        print logg "mirroring $package ($site:$remote_dir) completed successfully @ $now\n";
        print logg @log;
        close( logg );
    }

    if( $#log >= 0 && $mail_to =~ /./ ){
        local( $arg );
        eval "\$arg = \"$mail_subject\"";
        if( ! open( mail, "|$mail_prog $arg $mail_to" ) ){
            &msg( "Cannot run: $com\n\n" );
            return $exit_fail;
        }
        print mail "Mirrored $package ($site:$remote_dir -> $local_dir) $comment @ $now\n";
        print mail @log;
        close( mail );
    }
    undef( @log );

    &msg( "\n" );
    return $exit_status;
}


sub disconnect
{
    if( $connected ){
        &msg( "disconnecting from $connected\n" ) if $debug;
        if( ! $ftp'fatalerror ){
            &ftp'quit();
        }
    }
    $connected = '';
}

# Connect to the site
# Return 0 on a fail,
# 1 if a connection was successfully made,
# 2 if already connected to the site
sub connect
{
    local( $attempts ) = 1; # Retry ONCE! Be friendly.
    local( $res );

    if( $connected eq $site && $curr_remote_user eq $remote_user ){
        # Already connected to this site!
        return 2;
    }

    # Clear out any session active session
    &disconnect();

    if( $proxy ){
        $ftp'proxy = $proxy;
        $ftp'proxy_gateway = $proxy_gateway;
        $ftp'proxy_ftp_port = $proxy_ftp_port;
        $ftp'site = $site;
    }
    $res = &ftp'open( $site, $ftp_port, $retry_call, $attempts );
    if( $res == 1 ){
        # Connected
        $connected = $site;
    }
    return $res;
}

# This just prods the remote ftpd to prevent time-outs
sub prod
{
    if( $debug > 2 ){
        &msg( " prodding remote ftpd\n" );
    }
    &ftp'pwd();
}

# checkout and fixup any regexps.
# return 0 on an error
sub checkout_regexps
{
    local( $ret ) = 1;
    # Check out the regexps
    local( $t ) = 'x';
    foreach $r ( @regexp_values ){
        # regexps should never begin or end with a | or have
        # two in a row otherwise the pattern matches everything.
        # Use null to match everything if thats what you mean.
        $value{ $r } =~ s/\|+/|/g;
        $value{ $r } =~ s/^\|//;
        $value{ $r } =~ s/\|$//;
        local( $val ) = $value{ $r };
        next if ! $val;
        eval '$t =~ /$val/';
        if( $@ ){
            local( $err );
            chop( $err = $@ );
            &msg( "Problem with regexp $r ($err)\n" );
            $ret = 0;
        }
    }
    return $ret;
}

sub clear_local
{
    undef( @local_sorted );
    if( ! $use_files ){
        undef( %local_map );
    }
    undef( @local_time, @local_size,
        @local_type, @local_mode,
        @local_keep, @local_totals, @local_keep_totals );
}

sub clear_remote
{
    undef( @remote_sorted );
    if( ! $use_files ){
        undef( %remote_map );
    }
    undef( @remote_time, @remote_size,
        @remote_type, @remote_mode,
        @remote_keep, @remote_totals, @remote_keep_totals );
}

sub get_local_directory_details
{
    local( @dirs, $dir );
    local( $last_prodded ) = time; # when I last prodded the remote ftpd

    $next_local_mapi = $map_init;

    &clear_local();

    # Make sure the first elem is 0.
    push( @local_time, 0 );
    push( @local_size, 0 );
    push( @local_type, 0 );
    push( @local_mode, 0 );

    @get_top = ();

    &msg( "Scanning local directory $local_dir\n" ) if $debug;

    if( ! -d $local_dir ){
        if( $dont_do || $timestamp ){
            return 1;
        }
        &msg( "$local_dir no such directory - creating it\n" );
        if( &mkdirs( $local_dir ) ){
            push( @log, "Created dir $local_dir\n" );
            $exit_xfer_status |= $exit_xfers;
        }
        else {
            &msg( $log, "FAILED to create local dir $local_dir\n" );
        }
    }
    if( !chdir( $local_dir ) ){
        &msg( "Cannot change directory to $local_dir\n" );
        return 0;
    }

    if( $local_dir =~ m,^/, ){
        $cwd = $local_dir;
    }
    else {
        chop( $cwd = `pwd` );
    }

    # @dirs is the list of all directories to scan
    # As subdirs are found they are added to the end of the list
    # and as
    @dirs = ( "." );
    # Most of these variables should be locals in blocks below but
    # that seems to tickle a perl bug and causes a lot of memory to
    # be wasted.
    local( $dir_level ) = 0;
    local( $i ) = 0;
    local( $path, $time, $size, $type, $mode, $name, $isdir, $value, $follow );
    local( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
              $atime,$mtime,$ctime,$blksize,$blocks );
    while( defined( $dir = shift( @dirs ) ) ){

        if( !opendir( dir, $dir ) ){
            &msg( "Cannot open local directory $dir, skipping it\n" );
            next;
        }

        while( defined( $name = readdir( dir ) ) ){
            $isdir = 0;

            # Prod the remote system from time to time
            # To prevent time outs.  Only look once every 50 files
            # to save on unnecessary systems calls.
            if( ($i % 50 == 0) && time > ($last_prodded + $prod_interval) ){
                $last_prodded = time;
                &prod();
            }
            $i ++;

            $path = "$dir/$name";
            $path =~ s,(^|/)\./,,;
            next if $name eq '.' || $name eq '..' ||
                ($local_ignore && $path =~ /$local_ignore/);

            $follow = ($follow_local_symlinks ne '' && $path =~ /$follow_local_symlinks/);
            if( !$follow && -l $path ){
                $value = readlink( $path );
                ( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
                      $atime,$mtime,$ctime,$blksize,$blocks ) =
                    lstat( _ );
                $size = $ssize;
                $time = $mtime;
                $type = "l $value";
                $mode = $fmode;
            }
            elsif( ($isdir = ($follow ? (-d $path) : (-d _))) ||
                     -f _ ){
                ( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
                      $atime,$mtime,$ctime,$blksize,$blocks ) =
                    stat( _ );
                $size = $ssize;
                $time = $mtime;
                $mode = $fmode;
                if( $isdir ){
                    push( @dirs, $path ) if $recursive;
                    $type = 'd';
                }
                else {
                    $type = 'f';
                }
                if( $dir_level == 0 && $update_local ){
                    push( @get_top, $path );
                }
            }
            else {
                &msg( "unknown file type $path, skipping\n" );
                next;
            }
            if( $debug > 2){
                printf "local: %s %s %s %s 0%o\n",
                    $path, $size, $time, $type, $mode;
            }
            if( $max_age && $time != 0 && $time < $max_age ){
                &msg( "   too old: $path\n" ) if $debug > 1;
                next;
            }

            push( @local_sorted, $path );
            local( $mapi ) = $next_local_mapi++;
            $local_map{ $path } = $mapi;
            push( @local_time, $time );
            push( @local_size, $size );
            push( @local_type, $type );
            push( @local_mode, $mode );
            if( $type eq 'd' ){
                $local_totals[ 0 ]++;
            }
            else {
                $local_totals[ 1 ]++;
            }
        }
        closedir( dir );
        $dir_level++;

        if( ! $recursive ){
            last;
        }
    }
    return 1;
}

# Return true if the remote directory listing was brought back safely.
sub get_remote_directory_details
{
    local( $use_rls ) = 0;
    local( $type_changed ) = 0;
    local( $udirtmp );

    &msg( "Scanning remote directory $remote_dir\n" ) if $debug;

    $next_remote_mapi = $map_init;
    &clear_remote();

    # Make sure the first elem is 0.
    push( @remote_time, 0 );
    push( @remote_size, 0 );
    push( @remote_type, 0 );
    push( @remote_mode, 0 );

    if( ! &ftp'cwd( $remote_dir ) ){
        if( $get_file ){
            # no files to get
            return 0;
        }

        &msg( "Failed to change to remote directory ($remote_dir) trying to create it\n" );
        &mkdirs( $remote_dir );

        if( ! &ftp'cwd( $remote_dir ) ){
            &msg( "Cannot change to remote directory ($remote_dir) because: $ftp'response\n" );
            return 0;
        }
    }

    local( $rls );

    if( $local_ls_lR_file ){
        &msg( " Using local file $local_ls_lR_file for remote dir listing\n" ) if $debug;
        if( ! open( dirtmp, $local_ls_lR_file ) ){
            &msg( "Cannot open $local_ls_lR_file\n" );
            return 0;
        }
        $rls = "main'dirtmp";
    }
    elsif( $ls_lR_file ){
        local( $dirtmp );
        $dirtmp = "$big_temp/.dir$$";
        if( $ls_lR_file =~ /\.($sys_compress_suffix|$gzip_suffix|$old_gzip_suffix)$/ ){
            $dirtmp .= ".$1";
        }

        &msg( " Getting directory listing from remote file $ls_lR_file\n" ) if $debug;
        if( ! &ftp'get( $ls_lR_file, $dirtmp, 0 ) ){
            &msg( "Cannot get dir listing file\n" );
            return 0;
        }
        local( $unsquish );
        if( $dirtmp =~ /\.$sys_compress_suffix$/ ){
            $unsquish = $sys_compress_prog;
        }
        elsif( $dirtmp =~ /\.($gzip_suffix|$old_gzip_suffix)$/ ){
            $unsquish = $gzip_prog;
        }
          if( defined( $unsquish ) ){
              local( $f, $uf );
            $uf = $udirtmp = $dirtmp;
            $dirtmp =~ s/($shell_metachars)/\\$1/g;
              $f = $dirtmp;
              $dirtmp =~ s/\.($sys_compress_suffix|$gzip_suffix|$old_gzip_suffix)$//;
              $udirtmp =~ s/\.($sys_compress_suffix|$gzip_suffix|$old_gzip_suffix)$//;
            &sys( "$unsquish -d < \"$f\" > \"$dirtmp\"" );
              unlink( $uf );
          }

        open( dirtmp, $dirtmp ) || die "Cannot open $dirtmp";
        $rls = "main'dirtmp";
    }
    else {
        $use_ls = 1;
        if( ! &ftp'type( 'A' ) ){
            &msg( "Cannot set type to ascii for dir listing, ignored\n" );
            $type_changed = 0;
        }
        else {
            $type_changed = 1;
        }
    }

    $lsparse'fstype = $remote_fs;
    $lsparse'name = "$site:$package";

    if( $use_ls ){
         if( !&ftp'dir_open( $recursive ? $flags_recursive : $flags_nonrecursive ) ){
            &msg( "Cannot get remote directory listing because: $ftp'response\n" );
            return 0;
        }

        $rls = "ftp'NS";
    }

    $rcwd = '';
    if( $vms ){
        # Strip this off all pathnames to make them
        # relative to the remote_dir
        $rcwd = $remote_dir;
    }
    $dateconv'use_timelocal = $use_timelocal;
    if( !&lsparse'reset( $rcwd ) ){
        &msg( "$remote_fs: unknown fstype\n" );
        return 0;
    }
    if( $vms ){
        # Need to get in terms of the full pathname
        # so add it back in - see unix2vms at end of mirror
        $vms_dir = $remote_dir;
    }

    local( $parse_state ) = &parse_remote_details();

    if( $local_ls_lR_file ){
        close( dirtmp );
    }
    elsif( $ls_lR_file ){
        close( dirtmp );
        unlink( $udirtmp );
    }
    else {
        # Could optimise this out - but it makes sure that
        # the other end gets a command straight after a possibly
        # long dir listing.
        if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
            local( $msg ) = "Cannot reset type after dir listing, ";
            if( $type_changed ){
                # I changed it before - so I must be able to
                # change back unless something is wrong
                $msg .= "aborting\n";
                &msg( $msg );
                return 0;
            }
            else {
                $msg .= "ignoring\n";
                &msg( $msg );
            }
        }
    }

    # If the other end dropped part way thru make sure the
    # higher routines know!
    return $parse_state;
}

sub parse_timeout
{
    $parse_timed_out = 1;
    die "timeout: parse_remote_details";
}

sub parse_remote_details
{
    local( $ret );

    $parse_timed_out = 0;

    if( ! $use_ls ){
        # No need to bother with the timers
        return &parse_remote_details_real();
    }

    # This may timeout
    $SIG{ 'ALRM' } = "main\'parse_timeout";

    $ret = eval '&parse_remote_details_real()';

    alarm( 0 );

    if( $@ =~ /^timeout/ ){
        &msg( "timed out parsing directory details\n" );
        return 0;
    }
    return $ret;
}


sub parse_remote_details_real
{
    local( $path, $size, $time, $type, $mode, $rdir, $rcwd );
    local( @dir_list );
    local( $i ) = 0;

    if( $use_ls ){
        alarm( $parse_time );
    }

    # Need to loop in case $recurse_hard
    while( 1 ){
        while( !eof( $rls ) ){
            ( $path, $size, $time, $type, $mode ) =
                &lsparse'line( $rls );
            last if !$path;
            if( $debug > 2 ){
                printf "remote: %s %s %s %s 0%o\n",
                     $path, $size, $time, $type, $mode;
            }
            if( $use_ls ){
                # I just got something so shouldn't timeout
                alarm( $parse_time );
            }
            else {
                # Prod the remote system from time to time
                # To prevent time outs.  Only look once every
                # 50 files
                # to save on unnecessary systems calls.
                if( ($i % 50 == 0) &&
                    time > ($last_prodded + $prod_interval) ){
                    $last_prodded = time;
                    &prod();
                }
                $i ++;
            }


            if( $type eq 'd' && $recurse_hard ){
                push( @dir_list, $path );
            }

            if( $max_age && $time != 0 && $time < $max_age ){
                &msg( "   too old: $path\n" ) if $debug > 1;
                next;
            }

            if( $exclude_patt && $path =~ /$exclude_patt/ ){
                &msg( "   exclude: $path\n" ) if $debug > 1;
                next;
            }

            # If vms and only keeping the latest version
            if( $vms && !$vms_keep_versions ){
                # If we already have a file, pick the newer
                # TODO: pick the greatest version number
                local( $ri ) = $remote_map{ $path };
                if( $ri &&
                    $time > $remote_time[ $ri ] ){
                    $remote_time[ $ri ] = $time;
                    $remote_size[ $ri ] = $size;
                    $remote_type[ $ri ] = $type;
                    $remote_mode[ $ri ] = $mode;
                    next;
                }
            }

            push( @remote_sorted, $path );
            local( $mapi ) = $next_remote_mapi++;
            $remote_map{ $path } = $mapi;
            push( @remote_time, $time );
            push( @remote_size, $size );
            push( @remote_type, $type );
            push( @remote_mode, $mode );
            if( $type eq 'd' ){
                $remote_totals[ 0 ]++;
            }
            else {
                $remote_totals[ 1 ]++;
            }
        }

        if( $use_ls ){
            &ftp'dir_close();
        }

        if( $recurse_hard && $#dir_list < 0 ){
            # Make sure we end in the right directory.
            if( ! &ftp'cwd( $remote_dir ) ){
                &msg( "Cannot change to remote directory" .
                 " ($rdir) because: $ftp'response\n" );
                return 0;
            }
        }
        elsif( $recurse_hard ){
            $rcwd = shift( @dir_list );
            $rdir = "$remote_dir/$rcwd";
            if( $debug > 2 ){
                print "scanning: $remote_dir / $rcwd\n";
            }
            if( ! &ftp'cwd( $rdir ) ){
                &msg( "Cannot change to remote directory" .
                 " ($rdir) because: $ftp'response\n" );
                return 0;
            }
             if( !&ftp'dir_open( $recursive ? $flags_recursive : $flags_nonrecursive ) ){
                &msg( "Cannot get remote directory" .
                      " listing because: $ftp'response\n" );
                return 0;
            }
            &lsparse'reset( $rcwd );

            # round the loop again.
            next;
        }

        # All done - snap the loop
        last;
    }
    return 1;
}

sub compare_dirs
{
    local( *src_paths,
        *src_map, *src_time,
         *src_size, *src_type,
           *dest_paths,
        *dest_map, *dest_time,
         *dest_size, *dest_type,
          *dest_keep, *dest_keep_totals ) = @_;
    local( $src_path, $dest_path, $dest_index, $i );
    local( $last_prodded ) = time; # when I last prodded the remote ftpd
    local( $i );

    # Most of these variables should be locals in blocks below but
    # that seems to tickle a perl bug and causes a lot of memory to
    # be wasted.
    local( $desti, $srci, $compress, $srciZ, $srcigz, $split, $dest_path_real );
    local( $old_dest_path, $existing_path, $tmp, $tempi, $restart );
    local( $sp, $dp ) = ($#src_paths + 1, $#dest_paths + 1);

    &msg( "compare directories (src $sp, dest $dp)\n" ) if $debug;

    for( $i = 0; $i <= $#src_paths; $i++ ){
        $dest_path = $src_path = $src_paths[ $i ];

        $desti = $dest_map{ $dest_path };
        $srci = $i + 1;

        # Prod the remote system from time to time
        # To prevent time outs.  Only look once every 50 files
        # to save on unnecessary systems calls.
        if( ($i % 50 == 0) && time > ($last_prodded + $prod_interval) ){
            $last_prodded = time;
            &prod();
        }

        if( $debug > 2 ){
            &msg( "Compare src $src_path ($srci): " .
                &t2str( $src_time[ $srci ] ) );
            &msg( " $src_size[ $srci ] $src_type[ $srci ]\n" );
        }

        # I'm about to do a lot of matching on this
        study( $src_path );

        # Should I compress this file?
        #  Don't compress this file if trying to do a compress->gzip
        # conversion.
        $compress = 0;
        if( &will_compress( $src_path, $srci ) ){
            if( $dest_path !~ /$squished/o ){
                $srciZ = $src_map{ "$src_path.$sys_compress_suffix" };
                $srcigz = $src_map{ "$src_path.$gzip_suffix" };
                if( $srciZ || $srcigz ){
                    # There is a compressed version
                    # too!  Skip the uncompressed one
                    &msg( "   do not xfer, compressed version exists: $src_path\n" ) if $debug > 1;
                    next;
                }

                $compress = 1;
                $dest_path .= '.' . $compress_suffix;
                $desti = $dest_map{ $dest_path };
            }
        }
        # need to adjust the symlink pointer?
        elsif( $src_type[ $srci ] =~ /^l (.*)/ ){
           # Am I going to squish the file this points to?
           local( $real ) = &expand_symlink( $src_path, $1 );
           local( $reali ) = $src_map{ $real };
           if( &will_compress( $real, $reali ) ){
            # real is going to be (at least) squished so
            # suffix the dest
            $dest_path .= '.' . $compress_suffix;
            $desti = $dest_map{ $dest_path };
            $src_type[ $srci ] .= '.' . $compress_suffix;
            &msg( "  symlink pointer is now $dest_path\n" ) if $debug > 1;
            if( $src_map{ $dest_path } ){
                &msg( "do not xfer, $dest_path exists\n" ) if $debug > 1;
                next;
            }
           }
           if( &will_split( $real, $reali ) ){
            $src_type[ $srci ] .= '-split/README';
            &msg( "  symlink pointer now to $real-split/README'\n" ) if $debug > 1;
           }
        }

        # If this is a file that I decided not to compress but the
        # remote file is compressed and I want a gziped local version
        # then force compression.
        # This ignores any compress_excl flags.
        if( ! $compress &&
            $compress_suffix eq $gzip_suffix &&
            $compress_conv_patt && $src_path =~ /$compress_conv_patt/ ){
            $_ = $dest_path;
            eval $compress_conv_expr;
            $dest_path = $_;
            &msg( "   $src_path -> $dest_path\n" ) if $debug > 2;
            $desti = $dest_map{ $dest_path };
            $compress = 1;
        }

        # Am I converting the compression on the file this points to?
        if( $src_type[ $srci ] =~ /^l (.*)/ &&
              $compress_suffix eq $gzip_suffix ){
                local( $value ) = $1;
            local( $real ) = &expand_symlink( $src_path, $1 );
                local( $reali ) = $src_map{ $real };
                if( $src_type[ $reali ] ne 'd' &&
                $src_type[ $reali ] ne /^l .*/ &&
                $compress_conv_patt && $real =~ /$compress_conv_patt/ ){
                $dest_path =~ s/$sys_compress_suffix$/$gzip_suffix/;
                $desti = $dest_map{ $dest_path };
                $value =~ s/$sys_compress_suffix$/$gzip_suffix/;
                &msg( "  symlink pointer is now $dest_path (conv)\n")
                 if $debug > 1;
            }
            if( $name_mappings || $external_mapping ){
                    local( $old ) = $value;
                $value = &map_name( $value );
                if( $value ne $old ){
                    &msg( "   Mapped symlink value is $value\n" ) if $debug > 2;
                }

            }
            $src_type[ $srci ] = "l ".$value;
        }

        if( $name_mappings || $external_mapping ){
            local( $old_dest_path ) = $dest_path;
            $dest_path = &map_name( $dest_path );
            if( $dest_path ne $old_dest_path ){
                $desti = $dest_map{ $dest_path };
                &msg( "   Mapped name is $dest_path\n" ) if $debug > 2;
            }
        }

        # Should this file be split?
        $split = 0;
        $dest_path_real = undef;
        if( &will_split( $src_path, $srci ) ){
            $split = 1;
            $dest_path_real = $dest_path;
            $dest_path .= "-split/part01";
            $desti = $dest_map{ $dest_path };
        }

        if( $debug > 2 ){
            &msg( "       dest $dest_path ($desti): " .
                &t2str( $dest_time[ $desti ] ) );
            &msg( " $dest_size[ $desti ] $dest_type[ $desti ]" );
            &msg( " (->$compress_suffix)" ) if $compress;
            &msg( " (split)" ) if $split;
            &msg( "\n" );
        }

        if( $get_patt && $src_path !~ /$get_patt/ ){
            &msg( "   do not xfer: $src_path\n" ) if $debug > 1;
            next;
        }

        # Just create any needed directories (the timestamps
        # should be ignored)
        if( $src_type[ $srci ] eq 'd' ){
            if( $dest_type[ $desti ] ne 'd' ){
                push( @things_to_make, "d $dest_path" );
                &msg( "   need to mkdir $dest_path\n" ) if $debug > 1;
            }
            # keep the directory once made
            # (Also if local is really a symlink elsewhere
            #  it will be kept.)
            $dest_keep[ $desti ] = 1;
            $dest_keep_totals[ 0 ]++;
            &msg( "   keep $dest_path\n" ) if $debug > 2;
            next;
        }

        # Well that just leaves files and symlinks.
        # Do various checks on them.

        if( $desti && ! $dest_keep[ $desti ] ){
            $dest_keep[ $desti ] = 1;
            $dest_keep_totals[ 1 ]++;
            &msg( "   keep $dest_path\n" ) if $debug > 2;
            if( $split ){
                # Mark all the split parts as kept
                local( $dpp, $dps, $dpi );
                ($dpp, $dps) = ($dest_path =~ m,^(.*/)(part[0-9]+)$,);
                while( 1 ){
                    $dps++;
                    if( !($di = $dest_map{ $dpp . $dps }) ){
                        last;
                    }
                    $dest_keep[ $di ] = 1;
                    $dest_keep_totals[ 1 ]++;
                    &msg( "      keep $dpp$dps\n" ) if $debug > 2;
                }
                # And the README
                $dps = 'README';
                $di = $dest_map{ $dpp . $dps };
                if( $di ){
                    $dest_keep[ $di ] = 1;
                    $dest_keep_totals[ 1 ]++;
                    &msg( "      keep $dpp$dps\n" ) if $debug > 2;
                }
                # And the directory
                chop( $dpp );
                $dps = '';
                $di = $dest_map{ $dpp . $dps };
                if( $di ){
                    $dest_keep[ $di ] = 1;
                    $dest_keep_totals[ 0 ]++;
                    &msg( "      keep $dpp$dps\n" ) if $debug > 2;
                }
            }
        }

        local( $update ) = 0;

        if( ! $get_missing ){
            next;
        }

        if( $force || ! $dest_type[ $desti ] || $timestamp ){
            # Either I'm forcing xfers or the file doesn't exist
            # either way I should update
            $update = 1;
        }
        else {
            # Maybe the src is newer?
            if( $get_newer &&
               &compare_times( $src_time[ $srci ], $dest_time[ $desti ] ) ){
                &msg( "   src is newer, xfer it\n" ) if $debug > 2;
                $update = 1;
            }
            # or maybe its size has changed?
            # don't bother if file was compressed or split as the
            # size will have changed anyway
            if( !$compress && !$split &&
               $get_size_change &&
               ($src_type[ $srci ] eq 'f') &&
               ($src_size[ $srci ] != $dest_size[ $desti ]) ){
                $update = 1;
            }
            # Maybe it has changed type!
            if( $src_type[ $srci ] ne $dest_type[ $desti ] ){
                $update = 1;
            }
            if( $update && $debug > 2 ){
                &msg( "   src is different size, xfer it\n" );
            }
        }

        if( ! $update ){
            next;
        }

        if( $src_type[ $srci ] =~ /^l (.*)/ ){
            # If the symlink hasn't changed then may as well
            # leave it alone
            if( $src_type[ $srci ] eq $dest_type[ $desti ] ){
                next;
            }
            # DONT FORGET TO NAME MAP!!!!
            $existing_path = $1;

            if( $compress_suffix eq $gzip_suffix &&
                $compress_conv_patt && $existing_path =~ /$compress_conv_patt/ ){
                $_ = $existing_path;
                eval $compress_conv_expr;
                $existing_path = $_;
            }

            push( @things_to_make, "l $dest_path -> $existing_path" );
            &msg( "   need to symlink $dest_path -> $existing_path\n" ) if $debug > 2;
            next;
        }

        # Now that the tests are complete use the real dest.
        if( defined( $dest_path_real ) ){
            $dest_path = $dest_path_real;
            $desti = $dest_map{ $dest_path };
        }

        &msg( "$XFER file $src_path as $dest_path".
            ($compress ? " (->$compress_suffix)" : "") .
            ($split ? " (split)" : "") . "\n" ) if $debug > 1;
        push( @xfer_dest, $dest_path );
        push( @xfer_src, $src_path );

        # If xfers can be restarted AND
        # a temporary file exists from a previous attempt at a
        # transfer  AND
        # the timestamps of the exising temp file and the original
        # src file match then flag a restart.
        $tmp = &filename_to_tempname( '', $dest_path );
        $tmpi = $dest_map{ $tmp };
        $restart = '';
        if( $get_file &&
           $can_restart &&
           -f $tmp &&
           ($dest_time[ $tmpi ] eq $src_time[ $srci ]) ){
            # Then this is an xfer of the same file
            # so just restart where I left off
            $restart = 'r';
        }
        # x for xfer, c for compress, s for split
        push( @xfer_attribs,
             "x$restart" .
             ($compress ? "c" : "") .
             ($split ? "s" : "") );
    }
}

sub map_name
{
    local( $name ) = @_;

    if( $name_mappings ){
        local( $old_name ) = $name;
        $_ = $name;
        eval $name_mappings;
        if( $_ ne $old_name ){
            $name = $_;
        }
    }

    if( $external_mapping ){
        $old_name = $name;
        local( $tmp ) = &extmap'map( $name );
        if( $tmp ne $old_name ){
            $name = $tmp;
        }
    }
    return $name;
}


sub set_timestamps
{
    local( $src_path );

    &msg( "setting timestamps\n" );
    if( ! $get_file ){
        &msg( "Cannot set remote timestamps\n" );
        return;
    }

    local( $dest_path, $dest_loc_mapi, $src_rem_mapi,  $rtime );

    foreach $src_path ( @xfer_src ){
        $dest_path = shift( @xfer_dest );
        $dest_loc_mapi = $local_map{ $dest_path };
        $src_rem_mapi = $remote_map{ $src_path };

        $rtime = $remote_time[ $src_rem_mapi ];
        if( $dest_loc_mapi && $local_time[ $dest_loc_mapi ] ne $rtime ){
            &set_timestamp( $dest_path, $rtime );
        }
    }
}

sub set_timestamp
{
    local( $path, $time ) =  @_;

    if( $dont_do ){
        &msg( "Should set time of $path to $time\n" );
        return;
    }

    if( $timestamp || $debug > 2 ){
        &msg( "Setting time of $path to $time\n" );
    }
    utime( $time, $time, $path );
}

sub make_dirs
{
    local( $thing );

    return if $dont_do;

    foreach $thing ( @things_to_make ){
        if( $thing !~ /^d (.*)/ ){
            next;
        }
        &mkdirs( $1 );
    }
}

sub make_symlinks
{
    local( $thing );

    return if $dont_do;

    thing:
    foreach $thing ( @things_to_make ){
        if( $thing !~ /^l (.*) -> (.*)/ ){
            next;
        }
        local( $dest, $existing ) = ($1, $2);
        local( $dirpart ) = &dirpart( $dest );
        if( -e "$dirpart/$existing" ){
            # symlink to existing file.
            &mksymlink( $dest, $existing );
            next;
        }
        # The existing file doesn't actually exist!
        # Has it been compressed, gzipped, split? or worse
        # compressed/gzipped AND split.  (OK so it could
        # be another problem, bad symlink on remote host, file
        # that hasn't been xfer'd yet... but this is as good as
        # it gets.)
        local( $p );
        foreach $p (
            "\%s.$sys_compress_suffix",
            "\%s.$gzip_suffix",
            "\%s/README",
            "\%s-split/README",
            "\%s-split.$sys_compress_suffix/README",
            "\%s-split.$gzip_suffix/README" ){
            local( $f ) = sprintf( $p, $existing );
            if( -e $f ){
                &msg( "using $p\n" ) if $debug > 2;
                &mksymlink( $dest, $f );
                next thing;
            }
        }
        if( $make_bad_symlinks ){
            &msg( "symlink to non-existant file: $dest -> $existing\n" );
            &mksymlink( $dest, $existing );
        }
        else {
            &msg( "Not symlinking $dest -> $existing\n" );
        }
    }
}

sub do_all_transfers
{
    local( $src_path );

    if( $#xfer_src < 0 ){
        &msg( "No files to transfer\n" );
        return;
    }

    foreach $src_path ( @xfer_src ){
        local( $dest_path, $attribs );
        local( $srci );

        if( $get_file ){
            $srci = $remote_map{ $src_path };
        }
        else {
            $srci = $local_map{ $src_path };
        }

        $dest_path = shift( @xfer_dest );
        $attribs = shift( @xfer_attribs );

        if( $dont_do ){
            # Skip trying to get the file.
            next;
        }

        &msg( "Need to $XFER file $src_path as $dest_path ($attribs)\n" ) if $debug > 1;

#        &msg( "transferring $src_path " );
        local( $newpath ) =
            &transfer_file( $src_path, $dest_path,
                       $attribs, $remote_time[ $srci ] );
        if( $get_file && $newpath eq '' ){
            &msg( "Failed to $XFER file $ftp'response\n" );
            if( $ftp'response =~ /timeout|timed out/i ){
                $timeouts++;
            }
            if( $ftp'fatalerror || $timeouts > $max_timeouts ){
                &msg( "Fatal error talking to site, skipping rest of transfers\n" );
                &disconnect();
                return;
            }
            next;
        }

        # File will now have been split up.
        if( $attribs =~ /s/ ){
#            &msg( "\n" );
            next;
        }

        if( $newpath ne $src_path ){
#            &msg( "into $newpath" );
        }
#        &msg( "\n" );

        &set_attribs( $newpath, 'f' );

        # we can only force time for local files
        if( $force_times && $get_file ){
            &set_timestamp( $newpath, $remote_time[ $srci ] );
        }
    }
}


sub transfer_file
{
    local( $src_path, $dest_path, $attribs, $timestamp ) = @_;
    local( $dir, $file, $temp, $compress, $split, $restart, $mesg, $got_mesg );

    # Make sure the required directory exists
    $dir = "";
    if( $dest_path =~ /^(.+\/)([^\/]+)$/ ){
        ($dir, $file) = ($1, $2);
        if( $dest_type[ $dir ] ne 'd' && &mkdirs( $dir ) ){
            &msg( $log, "Created dir $dir\n" );
        }
    }
    else {
        $file = $dest_path;
    }

    $temp = &filename_to_tempname( $dir, $file );

    # Interpret the attrib characters
    if( $attribs !~ /x/ ){
        # Not an xfer!
        return '';
    }
    if( $attribs =~ /c/ ){
        $compress = 1;
        $mesg = " and compress";
    }
    if( $attribs =~ /s/ ){
        $split = 1;
        $mesg = " and split";
    }
    if( $attribs =~ /r/ ){
        $restart = 1;
    }

    if( $vms ){
        &ftp'type( ($src_file =~ /$vms_xfer_text/i) ? 'A' : 'I' );
    }

    if( ! $get_file ){
        # put the file remotely
        local( $src_file ) = $src_path;
        local( $comptemp ) = '';

        if( $compress ){
              # No easy way to tell wether this was compressed or not
              # for now just presume that it is.
              local( $f ) = $src_file;
            $f =~ s/($shell_metachars)/\\$1/g;
              $comptemp = "$big_temp/.out$$";
            &sys( "$compress_prog < \"$f\" > \"$comptemp\"" );
              $src_file = $comptemp;
        }

        if( ! &ftp'put( $src_file, $temp, $restart ) ){
            &msg( $log, "Failed to put $src_file: $ftp'response\n" );
            unlink( $comptemp ) if $comptemp;
            return '';
        }

        unlink( $comptemp ) if $comptemp;
        if( ! &ftp'rename( $temp, $dest_path ) ){
            &msg( $log, "Failed to remote rename $temp to $dest_path: $ftp'response\n" );
            return '';
        }

        # Some transfers done
        $exit_xfer_status |= $exit_xfers;

        return $dest_path;
    }

    # Get a file
    if( ! &ftp'get( $src_path, $temp, $restart ) ){
        &msg( $log, "Failed to get $src_path: $ftp'response\n" );

        # Time stamp the temp file to allow for a restart
        if( -f $temp ){
            utime( $timestamp, $timestamp, $temp );
            # Make sure this file is kept
            local( $ti ) = $local_map{ $temp };
            $local_keep[ $ti ] = 1;
            $local_keep_totals[ 0 ]++;
        }

        return '';
    }

    # Some transfers done
    $exit_xfer_status |= $exit_xfers;

    # delete source file after successful transfer
    if( $delete_source ){
        if( &ftp'delete( $path ) ){
            &msg( $log, "Deleted remote $lpath\n");
        }
        else {
            &msg( $log, "Failed to delete remote $lpath\n");
        }
    }

    if( $compress ){
        # Prevent the shell from expanding characters
          local( $f ) = $temp;
          local( $comp );
        $f =~ s/($shell_metachars)/\\$1/g;
          $temp = "$f.$compress_suffix";
          # Am I doing compress to gzip conversion?
           if( $src_path =~ /$compress_conv_patt/ &&
              $compress_suffix eq $gzip_suffix ){
            $comp = "$sys_compress_prog -d < \"$f\" | $gzip_prog > \"$temp\"";
          }
          else {
            $comp = "$compress_prog < \"$f\" > \"$temp\"";
          }
          &sys( $comp );
        $temp =~ s/\\($shell_metachars)/$1/g;
        $f =~ s/\\($shell_metachars)/$1/g;
          unlink( $f );
      }

    local( $filesize ) = &filesize( $temp );
    local( $sizemsg ) = $filesize;
    local( $srcsize ) = $remote_size[ $remote_map{ $src_path } ];
    if( $srcsize > $sizemsg && !$compress ){
        # should never happen, right?  right ...
        $sizemsg .= " (file shrunk from $srcsize!)";
    }
    elsif( $srcsize < $sizemsg ){
        # compression wasn't such a great idea
        $sizemsg .= " (file grew from $srcsize!)";
    }

    # Ok - chop it up into bits!
    if( $split ){
        local( $time ) = 0;
        if( $force_times ){
            $time = $remote_time[ $remote_map{ $src_path } ];
        }
        &bsplit( $temp, $dest_path, $time );
        unlink( $temp );
        $got_mesg .= " and split";
    }
    else {
        rename( $temp, $dest_path );
    }

    local( $as ) = '';
    if( $src_path ne $dest_path ){
        $as = " as $dest_path";
    }
    &msg( $log, "Got $src_path$as$got_mesg $sizemsg\n" );
    # Make sure to keep what you just got!  It may/may no have
    # been compressed or gzipped..
    local( $locali ) = $local_map{ $dest_path };
    $local_keep[ $locali ] = 1;

    &log_upload( $src_path, $dest_path, $got_mesg, $filesize );

    return( $dest_path );
}

sub filename_to_tempname
{
    local( $dir, $file ) = @_;

    # dir
# LIMITED NAMELEN
# if you are really limited in pathname length then
# change the .in. to just .
    return "$dir.in.$file.";
}


# Open, write, close - to try and ensure that the log will allways be filled
# in.
sub log_upload
{
    local( $src_path, $dest_path, $got_mesg, $size ) = @_;

    if( ! $upload_log ){
        return;
    }

    if( ! open( ulog, ">>$upload_log" ) ){
        print STDERR "Cannot write to $upload_log\n";
        return;
    }

    &myflock( 'ulog', $LOCK_EX );
    print ulog "$site:$remote_dir/$src_path -> $local_dir/$dest_path $size ";
    if( $got_mesg ){
        print ulog "($got_mesg)";
    }
    print ulog "\n";
    &myflock( 'ulog', $LOCK_UN );
    close( ulog );
}

sub do_deletes
{
    local( *src_paths,
        *src_map,
         *src_type, *src_keep,
          *src_totals, *src_keep_totals ) = @_;
    local( $files_to_go, $dirs_to_go );

    if( ! ($do_deletes || $save_deletes) ){
        return;
    }

    local( $src_path, $i );
    local( $orig_do_deletes ) = $do_deletes;
    local( $orig_save_deletes ) = $save_deletes;

    local( $del_patt ) = $delete_patt;
    if( $delete_get_patt ){
        $del_patt = $get_patt;
    }

    $files_to_go = $src_totals[ 1 ] - $src_keep_totals[ 1 ];
    $dirs_to_go = $src_totals[ 0 ] - $src_keep_totals[ 0 ];

    # Adjust totals by considering del_patt
    for( $i = $#src_paths; $i >= 0; $i-- ){
        $src_path = $src_paths[ $i ];
        $srci = $i + 1;

        if( !$src_keep[ $srci ] && $src_path !~ /$del_patt/ ){
            if( $src_type[ $srci ] =~ "d" ){
                $dirs_to_go--;
            }
            else {
                $files_to_go--;
            }
        }
    }

    # Check out file deletions
    if( $max_delete_files =~ /^(\d+)\%$/ ){
        # There is a % in the value - so its a percentage
        local( $per ) = $1;
        if( $per <= 0 || 100 < $per ){
            &msg( "silly percentage $max_delete_files, not deleting\n" );
            $do_deletes = 0;
            $save_deletes = 0;
        }
        else {
            # Don't do more than this percentage of files
            # Convert max_delete_files into the number of files
            $max_delete_files =
                int( $src_totals[ 1 ] * $max_delete_files /100 );
        }
    }
    if( $files_to_go > $max_delete_files ){
        &msg( "Too many files to delete, not actually deleting ($files_to_go > $max_delete_files)\n" );
        $do_deletes = 0;
        $save_deletes = 0;
    }

    # Check out directory deletions
    if( $max_delete_dirs =~ /^(\d+)%$/ ){
        # There is a % in the value - so its a percentage
        local( $per ) = $1;
        if( $per <= 0 || 100 < $per ){
            &msg( "silly percentage $max_delete_dirs, not deleting\n" );
            $do_deletes = 0;
            $save_deletes = 0;
        }
        else {
            # Don't do more than this percentage of dirs
            # Convert max_delete_dirs into the number of dirs
            $max_delete_dirs =
                int( $src_totals[ 0 ] * $max_delete_dirs / 100 );
        }
    }

    if( $dirs_to_go > $max_delete_dirs ){
        &msg( "Too many directories to delete, not actually deleting ($dirs_to_go > $max_delete_dirs)\n" );
        $do_deletes = 0;
        $save_deletes = 0;
    }

    # Scan the list backwards so subdirectories are dealt with first
    for( $i = $#src_paths; $i >= 0; $i-- ){
        $src_path = $src_paths[ $i ];
        $srci = $i + 1;

        if( $src_keep[ $srci ] ){
            # Keep this for sure;
            &msg( "Keeping: $src_path\n" ) if $debug > 3;
            next;
        }

        if( $src_path !~ /$del_patt/ ){
            &msg( "   not in del_patt: $src_path\n" ) if $debug > 1;
            next;
        }

        if( $delete_excl && $src_path =~ /$delete_excl/ ){
            &msg( "   do not delete: $src_path\n" ) if $debug > 1;
            next;
        }

        if( $save_deletes && $save_dir =~ m,$cwd/(.*), ){
            local( $save_dir_tail ) = $1;
            if( $save_dir_tail && $src_path =~ m,$save_dir_tail/*, ){
                next;
            }
        }

        if( $save_deletes ){
            &save_delete( $src_path, $src_type[ $srci ] );
        }
        else {
            &do_delete( $src_path, $src_type[ $srci ] );
        }
    }

    $do_deletes = $orig_do_deletes;
    $save_deletes = $orig_save_deletes;
}

# Move aside the given file.  Kind is 'd' for dirs and 'f' for files.
sub save_delete
{
    local( $save, $kind ) = @_;

    local( $real_save_dir, $save_dest );
    eval "\$real_save_dir = \"$save_dir\"";


    if( ! $get_file ){
        &msg( "NEED TO implement remote save_deletes\n" );
        return;
    }

    $save_dest = "$real_save_dir/$save";

    if( $dont_do ){
        &msg( "save_delete $save to $save_dest\n" );
        return;
    }

    if( $kind eq 'd' ){
        $save_dest =~ s,/+$,,;

        # Make sure it exists
        &save_mkdir( $save_dest );

        # Zap the original
        if( rmdir( $save ) == 1 ){
            &msg( $log, "Removed directory $save\n" );
        }
        else {
            &msg( $log, "UNABLE TO REMOVE DIRECTORY $save\n" );
        }
        return;
    }

    # Save a file

    # Make the directories under $save_dir
    local( $dirname );
    $dirname = $save_dest;
    $dirname =~ s/\/[^\/]+$//;
    # Make sure the directory exists to mv the file into.
    &save_mkdir( $dirname );

    if( rename( $save, $save_dest ) == 1 ){
        &msg( $log, "Moved $save to $save_dest\n" );
    }
    else {
        system "$mv_prog $save $save_dest";
        if( ( $? >> 8 ) == 0 ){
            &msg( $log, "Moved $save to $save_dest\n" );
        }
        else {
            &msg( $log, "UNABLE TO MOVE $save TO $save_dest\n" );
        }
    }
}

sub save_mkdir
{
    local( $dir ) = @_;

    if( ! -d $dir ){
        if( &mkdirs( $dir ) ){
            &msg( $log, "Created save directory $dir\n" );
        }
        else {
            &msg( $log, "UNABLE TO CREATE $dir, aborting saves\n" );
            $save_deletes = 0;
        }
    }
}

# Delete the given file.  Kind is 'd' for dirs and 'f' for files.
sub do_delete
{
    local( $del, $kind ) = @_;

    if( $dont_do ){
        &msg( "delete $del\n" );
        return;
    }

    if( $kind eq 'd' ){
        $del =~ s,/+$,,;
        if( $do_deletes ){
            if( $get_file ){
                &msg( $log, "rmdir $cwd/$del\n" );
                rmdir( "$cwd/$del" ) ||
                    &msg( $log, "rmdir $cwd/$del failed: $!\n" );
            }
            else {
                &msg( $log, "Cannot delete remote directories\n" );
            }
        }
        else {
            if( $get_file ){
                &msg( $log, "NEED TO rmdir $cwd/$del\n" );
            }
            else {
                &msg( $log, "NEED TO ftp'deldir $del\n" );
            }
        }
        return;
    }

    # Deleting a file.
    if( $do_deletes ){
        if( $get_file ){
            &msg( $log, "unlink $cwd/$del\n" );
            unlink( "$cwd/$del" ) ||
                &msg( $log, "unlink $cwd/$del failed: $!\n" );
        }
        else {
            &msg( $log, "delete $cwd/$del\n" );
            &ftp'delete( "$cwd/$del" ) &&
                &msg( $log, "ftp delete $cwd/$del failed\n" );
        }
    }
    else {
        if( $get_file ){
            &msg( $log, "NEED TO unlink $cwd/$del\n" );
        }
        else {
            &msg( $log, "NEED TO ftp'delete $del\n" );
        }
    }
}

sub filesize
{
    local( $fname ) = @_;

    if( ! -f $fname ){
        return -1;
    }

    return (stat( _ ))[ 7 ];

}

# Is the value
sub istrue
{
    local( $val ) = @_;

    return $val eq '1' || $val eq 'yes' || $val eq 'ok' ||
           $val eq 'true';
}

sub mksymlink
{
    local( $dest_path, $existing_path ) = @_;

    if( ! $get_file ){
        &msg( "Cannot create symlinks on remote systems ($dest_path -> $existing_path)\n" );
        return;
    }

    # make the symlink locally

    # Zap any exiting file/symlink of that name
    if( -d $dest_path && ! -l $dest_path ){
        local( $msg ) = "rmdir( $dest_path ) before symlink";
        if( ! rmdir( $dest_path ) ){
            &msg( "$msg failed: $!\n" );
            return;
        }
        elsif( $debug ){
            &msg( "$msg\n" );
        }
    }
    if( -e $dest_path || -l $dest_path ){
        local( $msg ) = "unlink( $dest_path ) before symlink";
        if( ! unlink( $dest_path ) ){
            &msg( "$msg failed: $!\n" );
            return;
        }
        elsif( $debug ){
            &msg( "$msg\n" );
        }
    }

    if( (eval 'symlink("","")', $@ eq '') ){
        local( $status ) = '';
        if( ! symlink( $existing_path, $dest_path ) ){
            $status = "Failed to ";
        }
        &msg( $log, $status . "symlink $existing_path to $dest_path\n" );
    }
    else {
        &msg( $log, "Tried to create symlink - but not supported locally\n" );
    }
}


# Make a full directory heirarchy
# returns true if the directory doesn't exist
sub mkdirs
{
    local( $dir ) = @_;
    local( @dir, $d, $path );

    # Very often the directory does exist - so return now
    return 0 if &dir_exists( $dir );

    # Make sure that the target directory exists
    @dirs = split( '/', $dir );

    # the root directory always exists
    $path = '';
    if( $dirs[ 0 ] eq '' ){
        shift( @dirs );
        $path = '/';
    }

    foreach $d ( @dirs ){
        $path = $path . $d;
        if( ! &dir_exists( $path ) ){
            &msg( "mkdir $path\n" ) if $debug > 2;
            if( ! &make_dir( $path, 0755 ) ){
                &msg( "make_dir($path,0755) failed with $err\n" );
                return 0;
            }
            &set_attribs( $path, 'd' );
        }
        $path .= "/";
    }
    return 1;
}

# return 0 on error, 1 on success
sub make_dir
{
    local( $dir, $mode ) = @_;
    local( $val );

    if( $get_file ){
        # make a local directory
        if( -e $dir || -l $dir ){
            unlink( $dir );
        }
        $val = mkdir( $dir, $mode );
        $err = "$!";
    }
    else {
        # make a remote directory
        $val = &ftp'mkdir( $dir );

        # The mkdir might have failed due to bad mode
        # So try to chmod it anyway
        if( $remote_has_chmod ){
            $val = &ftp'chmod( $dir, $mode );
        }
    }

    return $val;
}

# return 1 if $dir exists, 0 if not
sub dir_exists
{
    local( $dir ) = @_;
    local( $val );

    if( $get_file ){
        # check if local directory exists
        $val = (-d $dir);
    }
    else {
        # check if remote directory exists
        local($old_dir) = &ftp'pwd();

        $val = &ftp'cwd($dir);

        # go back to the original directory
        &ftp'cwd($old_dir) || die "Cannot cd to original remote directory";
    }
    return $val;
}

# Set file/directory attributes
sub set_attribs
{
    local( $path, $type ) = @_;
    local( $mode );

    if( $get_file ){
        local( $pathi ) = $remote_map{ $path };
        $mode = $remote_mode[ $pathi ];
    }
    else {
        local( $pathi ) = $local_map{ $path };
        $mode = $local_mode[ $pathi ];
    }

    # If I can't figure out the mode or I'm not copying it
    # use the default
    if( !$mode_copy || !$mode ){
        if( $type eq 'f' ){
            $mode = $file_mode;
        }
        elsif( $type eq 'd' ){
            $mode = $dir_mode;
        }
    }

    # Convert from octal
    $mode = oct( $mode ) if $mode =~ /^0/;

    if( $get_file ){
        # Change local

        chmod $mode, $path;

        if( $user ne '' && $group ne '' ){
            local( $uid, $gid );
            if( $user =~ /^\d+$/ ){
                # User is just a number - presume it is the uid
                $uid = $user;
            }
            else {
                $uid = (getpwnam( $user ))[ 2 ];
            }
            if( $group =~ /\d+$/ ){
                # Group is just a number - presume it is the gid
                $gid = $group;
            }
            else {
                $gid = (getgrnam( $group ))[ 2 ];
            }

            chown $uid, $gid, $path;
        }
    }
    else {
        # change the remote file
        if( $remote_has_chmod ){
            &ftp'chmod( $path, $mode );
        }
    }
}


sub get_passwd
{
    local( $user ) = @_;
    local( $pass );

    # prompt for a password
    $SIG{ 'INT' } = 'IGNORE';
    $SIG{ 'QUIT' } = 'IGNORE';

    system "stty -echo </dev/tty >/dev/tty 2>&1";
    print "Password for $user: ";

    $pass = <STDIN>;
    print "\n";
    chop( $pass );

    system "stty echo </dev/tty >/dev/tty 2>&1";

    $SIG{ 'INT' } = 'DEFAULT';
    $SIG{ 'QUIT' } = 'DEFAULT';

    return $pass;
}

sub compare_times
{
    # Try and allow for time zone changes (eg when a site
    # switches from daylight saving to non daylight saving)
    # by ignoring differences of exactly one hour

    local( $t1, $t2 ) = @_;
    local( $diff ) = ($t1 > $t2 ? $t1 - $t2 : $t2 - $t1);

    return ($t1 > $t2) && ($diff != 3600);
}

sub create_assocs
{
    local( $map );

    &delete_assocs();

    &msg( "creating assocs ...\n" ) if $debug > 2;
    foreach $map ( @assocs ){
        eval "\$$map = \"\$tmp/$map.$$\"";
        eval "dbmopen( $map, \$$map, 0644 )";
    }
    &msg( "creating assocs done\n" ) if $debug > 2;
}

sub delete_assocs
{
    local( $map );

    &msg( "deleting assocs ...\n" ) if $debug > 2;
    foreach $map ( @assocs ){
        eval "\$$map = \"\$tmp/$map.$$\"";
        eval "dbmclose( $map )";
        &unlink_dbm( eval "\$$map" );
        eval "\%$map = ()";
    }
    &msg( "deleting assocs done\n" ) if $debug > 2;
}

sub unlink_dbm
{
    local( $file ) = @_;
    unlink "$file.pag";
    unlink "$file.dir";
}

# Chop the tmp file up
sub bsplit
{
    local( $temp, $dest_path, $time ) = @_;
    local( $dest_dir ) = "$dest_path-split";
    local( $bufsiz ) = 512;
    local( $buffer, $in, $sofar );

    &msg( "Splitting up $temp into $dest_dir/ ($time)\n" ) if $debug;

    # Stomp on the original directories
    local( $d ) = $dest_dir;
    $d =~ s/($shell_metachars)/\\$1/g;
    &sys( "$rm_prog -rf \"$d\"" );

    &mkdirs( $dest_dir );

    local( $index ) = "00";
    local( $part );
    open( tmp, $temp ) || die "Cannot open $temp!";
    $sofar = $split_chunk; # Force a new file
    while( ($in = sysread( tmp, $buffer, $bufsiz )) > 0 ){
        if( $sofar >= $split_chunk ){
            if( $part ){
                close( part );
                if( $time ){
                    &set_timestamp( $part, $time );
                }
            }
            $index++;
            $part = "$dest_dir/part$index";
            &msg( "creating $part\n" ) if $debug;
            open( part, ">$part" ) || die "Cannot create $part";
            # Make sure to keep this!
            local( $locali ) = $local_map{ $part };
            $local_keep[ $locali ] = 1;
            $sofar = 0;
        }
        if( ($out = syswrite( part, $buffer, $in )) != $in ){
            die "Failed to write data to $part";
        }
        $sofar += $in;
    }
    close( part );
    if( $time ){
        &set_timestamp( $part, $time );
    }
    close( tmp );

    # Generate a readme file about what is in the split directory
    local( $readme ) = "$dest_dir/README";
    open( readme, ">$readme" ) || die "Cannot create $readme";
    print readme "This directory contains a splitup version of $dest_path\n";
    print readme "to recreate the original simply concatenate all the\n";
    print readme "parts back together.\n\nChecksums are:\n\n";
    close readme;
    &sys( "(cd \"$d\" ; $sum_prog part*)>> $readme" );
}

sub sys
{
    local( $com ) = @_;
    &msg( "$com\n" ) if $debug > 2;
    system( $com );
}

# Set up an associative array given all an array of keys.
# @fred = ( 'a' );
# &set_assoc_from_array( *fred )
# Creates => $fred{ 'a' } = 1
#
sub set_assoc_from_array
{
    local( *things ) = @_;
    foreach $thing ( @things ){
        $things{ $thing } = 1;
    }
}

sub find_prog
{
    local( $prog ) = @_;
    local( $path ) = $ENV{ 'PATH' } . ':' . $extra_path;

    foreach $dir ( split( /:/, $path ) ){
        local( $path ) = "$dir/$prog";
        if( -x $path ){
            return $path;
        }
    }
    return '';
}

sub real_dir_from_path
{
    local( $program ) = @_;
    local( @prog_path ) = split( m:/: , $program );    # dir collection
    local( $dir );

    while( -l $program ){                # follow symlink
        $program = readlink( $program );
        if( $program =~ m:^/: ){        # full path?
            @prog_path = ();        # start dir collection anew
        }
        else {
            pop( @prog_path );        # discard file name
        }
        push( @prog_path, split( m:/:, $program ) );# add new parts
        $program = join( '/', @prog_path );  # might be a symlink again...
    }
    pop( @prog_path );
    $dir = join( '/', @prog_path );

    if( ! $dir ){
        $dir = '.';
    }

    return $dir;
}

sub msg
{
    local( $todo, $msg );

    if( $#_ == 1 ){
        ($todo, $msg) = @_;
    }
    else {
        $todo = 0;
        $msg = @_[ 0 ];
    }

    # Assign to $0 so when you do a 'ps' it says this!
    if( $package ){
        $0 =  "mirror $package:$site:$remote_dir $msg";
    }
    else {
        $0 = "mirror $msg";
    }

    if( $todo & $log ){
        push( @log, $msg );
    }
# Not sure about this one.  always print the message even if its a log msg.
#    else {
        print $msg;
#    }
}

sub to_bytes
{
    local( $size ) = @_;
    if( $size =~ /^(\d+)\s*(k|b|m)s*$/i ){
        $size = $1;
        if( $2 =~ /[mM]/ ){
            $size *= (1024*1024);
        }
        elsif( $2 =~ /[bB]/ ){
            $size *= 512;
        }
        elsif( $2 =~ /[kK]/ ){
            $size *= 1024;
        }
    }
    return $size;
}

# Given a unix filename map it into a vms name.
# $kind is 'f' for files and 'd' for directories
sub unix2vms
{
    local( $v, $kind ) = @_;

    if( $v eq '.' || $v eq '/' ){
        return "[]";
    }

    if( $vms_dir ){
        $v = $vms_dir . '/' . $v;
    }

    if( $kind eq 'f' ){
        # Map a/b/c.txt into [a.b]c.txt
        if( $v =~ m,(.*)/([^/]+), ){
            local( $dir, $rest ) = ($1, $2);
            $dir =~ s,/,.,g;
            $v = "[$dir]$rest";
        }
    }
    else {
        # Map a/b/c into [a.b.c]
        $v =~ s,/,.,g;
        $v = "[$v]";
    }
    return $v;
}

sub dirpart
{
    local( $path ) = @_;
    if( $path =~ m:/: ){
        $path =~ s:^(.*)/[^/]+$:$1:;
    }
    else {
        $path = '.';
    }
    return $path;
}

# Given a filename (not a directory) and what path it symlinks to
# return a, hopefully, non-relative pathname that the symlink
# really points to.  This is so it can be used to index into the $src_path
# map.
sub expand_symlink
{
    local( $orig_path, $points_to ) = @_;
    local( $dirpart ) = &dirpart( $orig_path );

    return &flatten_path( "$dirpart/$points_to" );
}

# flatten out the effects of dir/.. and /./
# The problem is not flattening out ../.. into nothing!  Hence
# the contortions below.
sub flatten_path
{
    local( $path ) = @_;
    local( $changed ) = 1;
    local( $i );

    local( $rooted ) = $path =~ m:^/:;

    $path =~ s:^/::;
    $path =~ s:(^|/)\.(/|$)::g;

    while( $changed ){
        local( $in ) = $path;
        local( @parts ) = split( /\/+/, $path );
        for( $i = 0; $i <= $#parts; $i++ ){
            if( $parts[ $i ] eq '.' ){
                $parts[ $i ] = undef;
                next;
            }
            if( $i > 0 && $parts[ $i ] eq '..' &&
               $parts[ $i - 1 ] && $parts[ $i - 1 ] ne '..' ){
                $parts[ $i - 1 ] = $parts[ $i ] = undef;
                next;
            }
        }
        $path = '';
        for( $i = 0; $i <= $#parts; $i++ ){
            next unless $parts[ $i ];
            $path .= '/' if $path;
            $path .= $parts[ $i ];
        }
        $changed = $in ne $path;
    }
    if( $rooted ){
        $path = "/$path";
    }
    return $path;
}


# Fix up a package name.
# strip trailing and leading ws and replace awkward characters
# This doesn't guarentee a unique filename.
sub fix_package
{
    local( $package ) = @_;
    $package =~ s:[\s/']:_:g;
    return $package;
}

sub will_compress
{
    $src_type[ $_[1] ] eq 'f' &&
    $compress_patt && $_[0] =~ /$compress_patt/ &&
    ( ! $compress_size_floor ||
      $compress_size_floor < $src_size[ $_[1] ] ) &&
    !($compress_excl && $_[0] =~ /$compress_excl/i) &&
    !($compress_suffix eq $gzip_suffix &&
      $compress_conv_patt && $_[0] =~ /$compress_conv_patt/);
}

sub will_split
{
     $split_max &&
    $src_size[ $_[1] ] > $split_max &&
    $src_type[ $_[1] ] eq 'f' &&
    $split_patt && $_[0] =~ /$split_patt/;
}

sub myflock
{
    local( $file, $kind ) = @_;

    if( ! $can_flock ){
        return;
    }

    eval( "flock( \$file, $kind )" );
    if( $@ =~ /unimplemented/ ){
        $can_flock = 0;
        warn "flock not unavialable, running unlocked\n";
    }
}

sub t2str
{
    local( @t );
    if( $use_timelocal ){
        @t = localtime( $_[0] );
    }
    else {
        @t = gmtime( $_[0] );
    }
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @t;

    return sprintf( "%02d/%02d/%02d-%02d:%02d:%02d",
        $year, $mon + 1, $mday, $hour, $him, $sec );
}